home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#44 (May 89)
/
Sound Stuff
/
SoundPlayer.text
< prev
Wrap
Text File
|
1989-02-26
|
7KB
|
315 lines
' SoundPlayer
' Plays digitized sounds from snd resources
' and sound data files using
' MicroSoft QuickBasic 1.0
' by Ron Butcher 2/6/89
CLEAR, 100000&
DIM Paramblock%(39),scr%(3),bar%(3),pt%(2),r%(3)
DIM PHS$(200),id%(200)
DIM Reg&(5)
' Trap calls
RITE%=&HA003:Ohpen%=&HA000
Dread%=&HA002:Klose%=&HA001:GetEOF%=&HA011
NewPtr%=&HA01E : DisposePtr%=&HA01F
'Initialize variables and constants
FFsynthPtr&=0:Param&=0:Siz&=0:h&=0:S&=0:ResH&=0
oldbut%=0:butnum%=0:Tag&=0:state%=0
x0%=0:y0%=0:y%=0:x%=0
true%=-1:false%=0:GotPointer%=false%:er%=0
MenuItem%=0:MenuChoice%=0
ForkOpen%=false%:gotresource%=false%
num%=2:num1%=0:ref%=0:id%=0:action%=0
type$="snd ":nam$="":F$="":G$="":pic$=""
lfd&=0:I=0:count&=0:resid%=0
TwentyTwoK&=&H10000& ' count values
ElevenK&=&H8000&
SevenK&=&H5555&
FiveK&=&H4000&
ToolBox "i"
WINDOW CLOSE 1
MENU 1,0,1,"File"
MENU 1,1,1,"Open Sound Data"
MENU 1,2,1,"Open Sound Resource"
MENU 1,3,0,"Draw Sound Graph"
MENU 1,4,1,"Quit"
CmdKey 1,1,"D"
CmdKey 1,2,"R"
CmdKey 1,3,"G"
CmdKey 1,4,"Q"
Sheight=SYSTEM(6)
Swidth=SYSTEM(5)
WINDOW 2,"",(50,100)-(Swidth-32,Sheight-77),3
BUTTON 1,1,"22 KHz",(25,25)-(100,40),3
BUTTON 2,2,"11 KHz",(25,60)-(100,75),3
BUTTON 3,1,"7.4 KHz",(25,95)-(100,110),3
BUTTON 4,1,"5.5 KHz",(25,130)-(100,145),3
BUTTON 5,0,"Play",(130,75)-(190,100)
SetRect scr%(0),200,6,400,158
SetRect bar%(0),399,6,415,158
r%(0)=75
r%(1)=130
r%(2)=100
r%(3)=190
inSetRect r%(0),-4,-4
oldbut%=2:count&=ElevenK&
linenum%=0:top%=0:S&=0:in%=0
NewScroll S&,bar%(0),1,1,1,1
InactiveScroll S&
PICTURE ON
PENSIZE 3,3
FRAMEROUNDRECT VARPTR(r%(0)),16,16
PENNORMAL
ERASERECT VARPTR(scr%(0))
FRAMERECT VARPTR(scr%(0))
PICTURE OFF
pic$=PICTURE$
PICTURE ON : PICTURE OFF
refresh
ON MENU GOSUB MenSelect : MENU ON
ON DIALOG GOSUB ChoiceWait : DIALOG ON
UserWait:
WHILE true%
hittest
ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
WEND
ChoiceWait:
MENU STOP : MOUSE STOP
action%=DIALOG(0)
IF action%=5 THEN CALL refresh
IF action%<>1 THEN
MENU ON : MOUSE ON
RETURN
END IF
ON action% GOSUB HandleButton
MENU ON : MOUSE ON
RETURN
HandleButton:
butnum%=DIALOG(1)
IF butnum%=oldbut% THEN RETURN
IF butnum% <> 5 THEN
BUTTON butnum%,2
BUTTON oldbut%,1
oldbut%=butnum%
END IF
SELECT CASE butnum%
CASE 1
count&=TwentyTwoK&
CASE 2
count&=ElevenK&
CASE 3
count&=SevenK&
CASE 4
count&=FiveK&
CASE 5
GOSUB writefork
END SELECT
RETURN
openDataFile:
F$=FILES$(1,"FSSD"):IF F$="" THEN RETURN
BUTTON 5,0
gotresource% = false%
IF ForkOpen% THEN
GOSUB CleanItUp
ForkOpen%=false%
END IF
PtrTest
GOSUB ReadFork
Tag&=PEEKL(FFsynthPtr&+6) '"HCOM"
IF Tag&=1212370765& THEN BEEP:RETURN 'compressed
BUTTON 5,1
RETURN
openResFile:
F$=FILES$(1,"SFILSTAK"):IF F$="" THEN RETURN
BUTTON 5,0
PtrTest
in%=0:top%=0:linenum%=0:resid%=0
GOSUB CountResources
GOSUB ClearBuffer
RETURN
Quit:
IF ForkOpen% THEN GOSUB CleanItUp
PtrTest
DisposeScroll S&
WINDOW CLOSE 2
END
MenSelect:
MenuItem%=MENU(0)
IF MenuItem% <>1 THEN RETURN
MenuChoice%=MENU(1)
MENU
ON MenuChoice% GOSUB openDataFile,openResFile,Drawgraph,Quit
RETURN
writefork:
IF gotresource% THEN GOSUB LoadResource
POKEW FFsynthPtr&,0 '0 for ffmode
POKEL FFsynthPtr&+2,count& 'sizing value
Param&=VARPTR(Paramblock%(0))
POKE Param&+27,0 'reset permission
POKEW Param&+24,&HFFFC 'Sound Driver refnum
POKEL Param&+36,lfd& 'length to write
POKEW Param&+44,0 'ioPosMode
POKEL Param&+46,0 'ioPosOffSet
POKEL Param&+32,FFsynthPtr& 'address of synthrec
ToolBox "R",RITE%,Reg&(0),(Param&) ' call _Write
RETURN
ReadFork:
GOSUB ClearBuffer
B2PStr F$,G$
Param&=VARPTR(Paramblock%(0))
POKEL Param&+18,SADD(G$) 'address of filename
POKE Param&+27,1 'read only
ToolBox "R",Ohpen%,Reg&(0),(Param&) 'call _Open
ToolBox "R",GetEOF%,Reg&(0),(Param&) 'call _GetEOF
Param&=VARPTR(Paramblock%(0))
lfd&=PEEKL(Param&+28) 'file length
IF lfd& =0 THEN 'No data
ToolBox "R",Klose%,Reg&(0),(Param&)
BEEP : RETURN
END IF
Siz&=lfd&+6 '6 bytes for mode and count
GOSUB GetPointer
Param&=VARPTR(Paramblock%(0))
POKEL Param&+36,lfd& 'number of bytes to read
POKEL Param&+32,FFsynthPtr&+6 'block address
POKEW Param&+44,1 'ioPosMode read from start of file
ToolBox "R",Dread%,Reg&(0),(Param&) 'call _Read
ToolBox "R",Klose%,Reg&(0),(Param&) 'call _Close
RETURN
GetPointer:
'Get block of Siz& bytes and
'return address in FFsynthPtr&
ToolBox "R",NewPtr%,Reg&(0),,,(Siz&) 'call _NewPointer
GotPointer%=true%
FFsynthPtr&=Reg&(0)
RETURN
LoadResource:
IF resid%=id%(linenum%) THEN RETURN
PtrTest
'Get the resource
GetRes ref%,type$,id%(linenum%),h&
resid%=id%(linenum%)
HLock h&
GetHandleSize h&,lfd&
Siz&=lfd&
GOSUB GetPointer
'coerce pointer
ResH&=PEEKL(h&)
BlockMove ResH&,FFsynthPtr&,Siz&
Hunlock h&
ReleaseRes h&
RETURN
CountResources:
IF ForkOpen% THEN GOSUB CleanItUp:ForkOpen%=false%
PtrTest
CountRes type$,num% 'number in System
ToolBox "WQ",&H997,F$,ref% 'openresfile
ForkOpen%=true%
updateresfile ref%
CountRes type$,num1%
num1%=num1%-num% 'number of type snd
GOSUB GetResources
RETURN
GetResources:
'set ResLoad to false
POKEW &HA5E,0 'comment out for interpreter
FOR ind%=1 TO num1%
GetIndRes type$,ind%,h&
GetResInfo h&,id%(ind%),type$,nam$
ReleaseRes h&
PHS$(ind%)=nam$+" - "+STR$(id%(ind%))
NEXT ind%
'set ResLoad to true
POKEW &HA5E,-1 'comment out for interpreter
gotresource%=true%
ActiveScroll S&
RETURN
ClearBuffer:
Param&=VARPTR(Paramblock%(0))
FOR I=0 TO 79: POKE Param&+I,0: NEXT I
RETURN
CleanItUp:
CloseResfile ref%
InactiveScroll S&
in%=0:top%=0:linenum%=0:resid%=0:num1%=0
RETURN
Drawgraph:
DIALOG STOP :MENU OFF
WINDOW 3,"",(0,20)-(Swidth,Sheight),3
MOVETO 0,0
inc=lfd&\Swidth
x0%=0:y0%=0:y%=0:x%=0
FOR I=1 TO lfd& STEP inc
LINETO x0%,y%
y%=PEEK(FFsynthPtr&+(I))
y%=(128-y%)+128 'Invert it
PSET (x%,y%)
x0%=x%
x%=x%+1
NEXT I
TEXTFONT 0
MOVETO 180,300
DrawText "Click Mouse to Continue"
TEXTFONT 1
WHILE MOUSE(0)=0:WEND
WINDOW CLOSE 3
WINDOW 2
DIALOG ON:MENU ON
RETURN
SUB hittest STATIC
SHARED scr%(),pt%(),num1%,linenum%,gotresource%
in%=0
IF NOT gotresource% THEN EXIT SUB
IF MOUSE(0)=1 THEN
GetMouse pt%(1)
PtInRect pt%(1),scr%(0),in%
IF in% THEN
found
END IF
IF linenum%<>0 AND linenum%<=num1% THEN
state%=1
ELSE
state%=0
END IF
BUTTON 5,state%
refresh
END IF
END SUB
SUB found STATIC
SHARED linenum%,num1%,top%,pt%(),scr%()
linenum%=top%+(pt%(1)-scr%(0))\20
END SUB
SUB refresh STATIC
SHARED scr%(),PHS$(),S&,num1%,linenum%,pic$
PICTURE,pic$
top%=0
ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
END SUB
SUB PtrTest STATIC
SHARED GotPointer%,Reg&(),FFsynthPtr&
DisposePtr%=&HA01F
IF GotPointer% THEN 'call _DisposePointer
CALL ToolBox("R",DisposePtr%,Reg&(0),(FFsynthPtr&))
GotPointer%=0
END IF
END SUB